# plsc function #10.15.2012

plsc <- function(X,Y){
#This function will do PLS-C on matrices X and Y
	
	#1.Check things
	#Do X and Y have I rows?
	if (nrow(X)!=nrow(Y)){
		print("ERROR: Number of rows of X and Y are not equal.")
		return(0)
	}
	
	#2.Normalize X and Y
	Zx <- norm.mat(X)
	Zy <- norm.mat(Y)

	#3.Get R (the correlation matrix)
	R <- t(Zx) %*% Zy
	
	#4.SVD the R matrix
	svd.R <- svd(R)

	L <- length(svd.R$d)
	delta <- svd.R$d
	eigs <- delta^2
	tau <- eigs/sum(eigs) * 100
	P <- svd.R$u
	rownames(P) <- colnames(X)
	Q <- svd.R$v
	rownames(Q) <- colnames(Y)
	colnames(P) <- paste("Component ",seq(1,length(delta),1),sep="") -> colnames(Q)

	#5.Compute the latent variables
	Lx <- Zx %*% P
	rownames(Lx) <- rownames(X)
	Ly <- Zy %*% Q
	rownames(Ly) <- rownames(Y)
	colnames(P) <- paste("Component ",seq(1,length(delta),1),sep="") -> colnames(Q)
	
	pls.list <- list(LatentX=Lx,LatentY=Ly,eigenvalues=eigs,perc.explained=tau,LoadingsX=P,LoadingsY=Q,singular.values=delta,Correlation.XY=R)
	return(pls.list)
	#return(list(SalienceX=P, SalienceY=Q, Sing.Vals=delta, LatentX=Lx, LatentY=Ly, Corr.XY=R))
}


##private function; to be used in here.
norm.mat <- function(DATA){
	return( scale(DATA) / (sqrt(nrow(DATA)-1)) )
}


##private function; for plotting
plsc.plots <- function(results,which_axis=1){
	
	dev.new()
	plot(results$LatentX[,which_axis],results$LatentY[,which_axis],main=paste("Saliences ",which_axis,sep=""),xlab="Latent X",ylab="Latent Y")
	text(results$LatentX[,which_axis],results$LatentY[,which_axis],labels=rownames(results$LatentX),pos=3)
	
	dev.new()
	barplot(results$LoadingsX[,which_axis], main=paste("Saliences of X on Component ",which_axis,sep=""))
	dev.new()
	barplot(results$LoadingsY[,which_axis], main=paste("Saliences of Y on Component ",which_axis,sep=""))
}
